home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / TOOLBOX / AESTOOL.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-03-05  |  5.5 KB  |  227 lines
  1. IMPLEMENTATION MODULE AESTool;
  2.  
  3. (*
  4. AES Tools.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM PORTAB     IMPORT ANYPOINTER;
  12. FROM pSTORAGE   IMPORT ALLOCATE,DEALLOCATE;
  13. #if (defined LPRM2) || (defined SPCM2)
  14. FROM Register   IMPORT D0;
  15. FROM SYSTEM     IMPORT VAL,LONG,SETREG,INLINE;
  16. #elif (defined HM2)
  17. FROM Register   IMPORT D0;
  18. FROM SYSTEM     IMPORT CAST,LOAD,CODE;
  19. #elif (defined MM2)
  20. FROM Calls      IMPORT Registers,NewCaller;
  21. FROM MOSGlobals IMPORT MemArea;
  22. FROM SYSTEM     IMPORT CAST,ADR,WORD,BYTE;
  23. #elif (defined TDIM2)
  24. FROM Register   IMPORT D0;
  25. FROM SYSTEM     IMPORT SETREG,CODE;
  26. #elif (defined FSTM2)
  27. FROM SYSTEM     IMPORT ASSEMBLER;
  28. #elif (defined SDSM2)
  29. FROM SYSTEM     IMPORT CODE,RegAX,RegBX,RegCX,RegDX,WORD,ADR,ADDRESS;
  30. #elif (defined LM2)
  31. FROM SYSTEM     IMPORT CODE,SETREG,AX,BX,CX,DX,ADR,ADDRESS;
  32. #elif (defined TSM2)
  33. FROM SYSTEM     IMPORT Seg,Ofs,WORD,BYTE;
  34. #endif
  35. FROM SYSTEM     IMPORT TSIZE;
  36.  
  37. IMPORT AES,GetObject,SetObject;
  38.  
  39. #if (defined LPRM2) || (defined SPCM2)
  40. PROCEDURE FrameCode(VAR PB: AES.ParmBlk);
  41.  
  42. CONST PUSH   = 48E7H;
  43.       A3D3D7 = 1F10H;
  44.       POP    = 4CDFH;
  45.       D3D7A3 = 08F8H;
  46.       UNLKA6 = 4E5EH;
  47.       POPA4  = 285FH;
  48.       RTS    = 4E75H;
  49.  
  50. #elif (defined TDIM2)
  51. (*$P-*)
  52. PROCEDURE FrameCode(VAR PB: AES.ParmBlk);
  53.  
  54. CONST PBParm = 0001AH;
  55.       PUSH   = 048E7H;
  56.       D35A35 = 01C1CH;
  57.       POP    = 04CDFH;
  58.       A35D35 = 03838H;
  59.  
  60. #elif (defined HM2)
  61. PROCEDURE FrameCode(VAR PB: AES.ParmBlk);
  62.  
  63. CONST POPA5  = 2A5FH;
  64.       UNLKA6 = 4E5EH;
  65.       RTS    = 4E75H;
  66.  
  67. #elif (defined MM2)
  68. VAR Stack: ARRAY [0..2047] OF BYTE;
  69.  
  70. PROCEDURE FrameCode(VAR Regs: Registers);
  71.  
  72. TYPE ParmBlkPtr = POINTER TO AES.ParmBlk;
  73.  
  74. VAR PB: ParmBlkPtr;
  75.  
  76. #elif (defined ANAM2) || (defined FTLM2)
  77. PROCEDURE FrameCode(VAR PB: AES.ParmBlk): AES.ObjectState;
  78.  
  79. #elif (defined FSTM2)
  80. PROCEDURE FrameCode();
  81.  
  82. TYPE ParmBlkPtr = POINTER TO AES.ParmBlk;
  83.  
  84. VAR State: CARDINAL;
  85.     PB   : ParmBlkPtr;
  86.  
  87. #elif (defined TSM2_2)
  88. PROCEDURE FrameCode(): AES.ObjectState;
  89.  
  90. #else
  91. PROCEDURE FrameCode(VAR PB: AES.ParmBlk): AES.ObjectState;
  92. #endif
  93.  
  94. BEGIN
  95. #if (defined LPRM2) || (defined SPCM2)
  96.   (* Thanks a lot H. Kleinschmidt for this hack *)
  97.   INLINE(PUSH,A3D3D7);
  98.   SETREG(D0,LONG(PB.PBParm^.Func(PB)));
  99.   INLINE(POP,D3D7A3);
  100.   INLINE(UNLKA6,POPA4,RTS);
  101.  
  102. #elif (defined MM2)
  103.   (* Thanks a lot T. Tempelmann for this hack *)
  104.   PB:= Regs.parm^.ad;
  105.   Regs.regD0.w:= CAST(WORD,PB^.PBParm^.Func(PB^));
  106.  
  107. #elif (defined ANAM2) || (defined FTLM2)
  108.   RETURN PB.PBParm^.Func(PB);
  109.  
  110. #elif (defined TDIM2)
  111.   (* Thanks a lot H. Kleinschmidt for help *)
  112.   CODE(04E56H,00000H); (* LINK    A6,#0000H     *)
  113.   CODE(PUSH,D35A35);   (* MOVEM.L D3-D5/A3-A5,-(A7) *)
  114.  
  115. (* the following code does nothing more than
  116.   SETREG(D0,PB.PBParm^.Func(PB));
  117. *)
  118.   CODE(0286EH,00008H); (* MOVE.L  PB(A6),A4     *)
  119.   CODE(0286CH,PBParm); (* MOVE.L  PBParm(A4),A4 *)
  120.   CODE(0558FH);        (* SUBQ.L  #2,A7         *)
  121.   CODE(0266EH,00008H); (* MOVE.L  PB(A6),A3     *)
  122.   CODE(04853H);        (* PEA     (A3)          *)
  123.   CODE(02854H);        (* MOVE.L  (A4),A4       *)
  124.   CODE(04E94H);        (* JSR     (A4)          *)
  125.   CODE(0588FH);        (* ADDQ.L  #4,A7         *)
  126.   CODE(0301FH);        (* MOVE.W  (A7)+,D0      *)
  127.   CODE(POP,A35D35);    (* MOVEM.L (A7)+,D3-D5/A3-A5 *)
  128.   CODE(04E5EH);        (* UNLK    A6            *)
  129.   CODE(04E75H);        (* RTS                   *)
  130.  
  131. #elif (defined FSTM2)
  132.   (* fetch parameter from AX:BX *)
  133.  
  134.   ASM
  135.     MOV SEG PB,AX
  136.     MOV OFFSET PB,BX
  137.   END;
  138.  
  139.   (* The state is expected in AX. RETURN would do this, but adds 4 to the *)
  140.   (* stack pointer, so this will not follow C calling conventions.        *)
  141.  
  142.   State:= CARDINAL(PB.PBParm^.Func(PB^));
  143.  
  144.   ASM
  145.     MOV AX,State (* move state in AX                  *)
  146.     RETF         (* avoid stack adding by Modula code *)
  147.   END;
  148. #elif (defined HM2)
  149.   LOAD(PB.PBParm^.Func(PB),D0);
  150.   CODE(POPA5);
  151.   CODE(UNLKA6);
  152.   CODE(RTS);
  153. #else
  154.   RETURN PB.PBParm^.Func(PB);
  155. #endif
  156. END FrameCode;
  157. #ifdef TDIM2
  158. (*$P=*)
  159. #endif
  160.  
  161. PROCEDURE NewObject(Tree  : AES.TreePtr;
  162.                     Index : AES.ObjectIndex;
  163.                     MyFunc: AES.UserDefFunc;
  164.                     MyParm: ANYPOINTER): BOOLEAN;
  165.  
  166. #ifdef MM2
  167. VAR Mem: MemArea;
  168. #endif
  169.  
  170. BEGIN
  171.   SetObject.Type(Tree,Index,AES.GUserDef);
  172.   WITH Tree^[Index].ObSpec DO
  173.     ALLOCATE(UserBlock,TSIZE(AES.UserBlk));
  174.     IF UserBlock # NIL THEN
  175.       WITH UserBlock^ DO
  176. #ifdef MM2
  177.         WITH Mem DO
  178.           bottom:= ADR(Stack);
  179.           length:= SIZE(Stack);
  180.         END;
  181.  
  182.         NewCaller(FrameCode,FALSE,Mem,UBCode);
  183.  
  184.         IF UBCode = NIL THEN
  185.           RETURN FALSE;
  186.         END;
  187. #else
  188.         UBCode:= FrameCode;
  189. #endif
  190.         ALLOCATE(UBParm,TSIZE(AES.UserDefBlk));
  191.  
  192.         IF UBParm # NIL THEN
  193.           WITH UBParm^ DO
  194.             Func:= MyFunc;
  195.             Parm:= MyParm;
  196.           END;
  197.         ELSE
  198.           RETURN FALSE;
  199.         END;
  200.  
  201.       END;
  202.     ELSE
  203.       RETURN FALSE;
  204.     END;
  205.   END;
  206.   RETURN TRUE;
  207. END NewObject;
  208.  
  209. PROCEDURE DisposeObject(Tree : AES.TreePtr;
  210.                         Index: AES.ObjectIndex;
  211.                         Type : AES.ObjectTypes);
  212.  
  213. VAR Parm: ANYPOINTER;
  214.     Spec: AES.ObjectSpec;
  215.  
  216. BEGIN
  217.   Spec.Address:= GetObject.Spec(Tree,Index);
  218.   Parm:= Spec.UserBlock^.UBParm^.Parm;
  219.   DEALLOCATE(Spec.UserBlock^.UBParm,TSIZE(AES.UserDefBlk));
  220.   DEALLOCATE(Spec.UserBlock,TSIZE(AES.UserBlk));
  221.   SetObject.Type(Tree,Index,Type);
  222.   Spec.Address:= Parm;
  223.   SetObject.Spec(Tree,Index,Spec);
  224. END DisposeObject;
  225.  
  226. END AESTool.
  227.